home *** CD-ROM | disk | FTP | other *** search
/ Acorn RISC PD-CD 1 / Acorn RISC PD-CD 1.iso / languages / _tile / f83 / double < prev    next >
Encoding:
Text File  |  1991-08-15  |  2.3 KB  |  88 lines
  1. \
  2. \  DOUBLE PARAMETER STACK WORD DEFINITIONS
  3. \
  4. \  Copyright (C) 1990 by Mikael R.K. Patel
  5. \
  6. \  Computer Aided Design Laboratory (CADLAB)
  7. \  Department of Computer and Information Science
  8. \  Linkoping University
  9. \  S-581 83 LINKOPING
  10. \  SWEDEN
  11. \
  12. \  Email: mip@ida.liu.se
  13. \
  14. \  Started on: 26 February 1990
  15. \
  16. \  Last updated on: 26 February 1990
  17. \
  18. \  Dependencies:
  19. \       (forth) forth, structures, macros
  20. \
  21. \  Description:
  22. \       Stack manipulation definitions for pairs of parameters.
  23. \
  24. \  Copying:
  25. \       This program is free software; you can redistribute it and\or modify
  26. \       it under the terms of the GNU General Public License as published by
  27. \       the Free Software Foundation; either version 1, or (at your option)
  28. \       any later version.
  29. \
  30. \       This program is distributed in the hope that it will be useful,
  31. \       but WITHOUT ANY WARRANTY; without even the implied warranty of
  32. \       MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  33. \       GNU General Public License for more details.
  34. \
  35. \       You should have received a copy of the GNU General Public License
  36. \       along with this program; see the file COPYING.  If not, write to
  37. \       the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. 
  38.  
  39. .( Loading Double Parameter definitions...) cr
  40.  
  41. #include <Tile$Lib>.structures
  42. #include <Tile$Lib>.macros
  43.  
  44. structures macros forth definitions
  45.  
  46. struct.type DOUBLE ( low high -- )
  47.   long +high ( double -- addr)
  48.   long +low ( double -- addr)
  49. struct.init ( low high double -- )
  50. #ifundef 2!
  51.   tuck +high ! +low !
  52. #else
  53.   2!
  54. #then
  55. struct.end
  56.  
  57. : double ( low high -- )
  58.   create , ,
  59. does> ( double -- low high)
  60. #ifundef 2@
  61.   dup +low @ swap +high @ 
  62. #else
  63.   2@
  64. #then
  65. ;
  66.  
  67. : .double ( addr -- )
  68.   ." double#" dup . ." high: " dup +high @ . ." low: " +low @ .
  69. ;
  70.  
  71.  
  72. #ifundef 2swap \ Check if the kernel supports double parameters
  73.   
  74. : 2>r ( a b -- ) >r >r ; macro compilation
  75. : 2r> ( -- a b) r> r> swap ; macro compilation
  76. : 2drop ( a b - ) drop drop ; macro
  77. : 2swap ( a b c d -- c d a b) rot >r rot r> ; macro
  78. : 2rot ( a b c d e f -- c d e f a b) 2>r 2swap 2r> 2swap ;
  79. : 2dup ( a b -- a b a b) over over ; macro
  80. : 2over ( a b c d -- a b c d a b) 3 pick 3 pick ; macro
  81. : 2@f ( addr -- a b) dup +low @ swap +high @ ; macro
  82. : 2! ( a b addr -- ) tuck +high ! +low ! ; macro
  83.  
  84. #then
  85.  
  86. forth only
  87.  
  88.